home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 007 / asynch.pqs / asynch.pas
Pascal/Delphi Source File  |  1984-12-20  |  12KB  |  254 lines
  1.  
  2. Type tComPort =  (Com1, Com2);
  3.      tBaud = (b110, b150, b300, b600, b1200, b2400, b4800, b9600);
  4.      tParity = (pSpace, pOdd, pMark, pEven, pNone);
  5.      tDatabits = (d5, d6, d7, d8);
  6.      tStopbits = (s1, s2);
  7.  
  8. Type tSaveVector = record     {  Saved Com interrupt vector          }
  9.        IP: integer;
  10.        CS: integer;
  11.      end;
  12. Type regpak =
  13.            record AX, BX, CX, DX, BP, SI, DI, DS, ES, FLAGS:integer end;
  14.  
  15. Const ourDS: integer = -1;    {  Will be init to contents of our DS
  16.                                   for later use in Interrupt routine  }
  17.  
  18.                          {  Define address adders for the various
  19.                              Async card registers.                    }
  20. Const RBR = $00;         { xF8   Receive Buffer Register             }
  21.       THR = $00;         { xF8   Transmitter Holding Register        }
  22.       IER = $01;         { xF9   Interrupt Enable Register           }
  23.       IIR = $02;         { xFA   Interrupt Identification Register   }
  24.       LCR = $03;         { xFB   Line Control Register               }
  25.       MCR = $04;         { xFC   Modem Control Register              }
  26.       LSR = $05;         { xFD   Line Status Register                }
  27.       MSR = $06;         { xFE   Modem Status Register               }
  28.       DLL = $00;         { xF8   Divisor Latch Least Significant     }
  29.       DLM = $01;         { xF9   Divisor Latch Most  Significant     }
  30.                          {       ASynch Interrupt Masks              }
  31.       imlist: array[Com1..Com2] of integer = ($EF, $F7);
  32.                               {  ASynch hardware interrupt addresses }
  33.       ivlist: array[Com1..Com2] of integer = ($000C, $000B);
  34.       PICCMD = $20;           {  8259 Priority Interrupt Controller  }
  35.       PICMSK = $21;           {  8259 Priority Interrupt Controller  }
  36.  
  37.                               {  Asynch base port addresses are
  38.                                   in the ROM BIOS data area           }
  39. Var   ComBaseAddr: array[Com1..Com2] of integer Absolute $0040:$0000;
  40.  
  41. {
  42.     Define a ring buffer for Asynch_Interrupt to write into
  43.     and ReadCom to read from.
  44. }
  45. Var ringbuf: array[0..8000] of char;
  46.     readptr, writptr: 0..80000; {  Index which ReadCom will next read from
  47.                                    Index which Asunch_Interrupt will next
  48.                                    write into. If readptr=writptr then
  49.                                    the buffer is empty.                }
  50.  
  51. Var LSRstat: byte;                     {  Line Status Reg at interrupt        }
  52.     ComSaveVec: tSaveVector;           {  saved Async Interrupt vector        }
  53.     ComBase :integer;                  {  Opened Com port base address        }
  54.     ActiveComPort: tComPort;           {  Opened Com                          }
  55.     imvalue: integer;                  {  Interrupt Mask value in use         }
  56. type lstring = string[255];
  57.  
  58. Procedure SwapIntVector(IntVect: integer;
  59.                         Var SaveVector: tSaveVector);
  60. Var   dosregs: regpak;
  61. Begin
  62.   inline($FA);                          {  cli        disable interrupts       }
  63.  
  64.   With dosregs Do Begin
  65.     ax := ($35 * 256) + IntVect;
  66.     MsDos(dosregs);                     {  DOS function 35 - get vector        }
  67.     ds := SaveVector.CS;
  68.     dx := SaveVector.IP;
  69.     SaveVector.CS := es;
  70.     SaveVector.IP := bx;
  71.     ax := ($25 * 256) + IntVect;
  72.     MsDos(dosregs);                     {  DOS function 25 - set vector        }
  73.   End;
  74.   inline($FB);                          {  sti        re-enable ints           }
  75. End;
  76.  
  77. {       This routine gets control upon an Asynch Interrupt           }
  78.  
  79. Procedure Asynch_Interrupt;
  80. Var dummy: array[1..8] of integer; {  Leave room for our push's      }
  81.     MSRstat, IIRreg: byte;
  82. Begin
  83. {
  84.                              BP-4   Return IP
  85.                              BP-2   Return CS
  86.                              BP---> Caller's BP
  87. }
  88.                                         {  Push regs but DON'T enable - we can't
  89.                                   handle another interrupt now        }
  90.   inline($50/$53/$51/$52/$57/$56/$06);
  91.   inline($1E);                          {  push   ds       save ds, also       }
  92.   inline($2E/$8E/$1E/ourDS);            {  mov   DS,CS:ourDS  ;Setup our DS    }
  93.  
  94.   IIRreg := PORT[ComBase + IIR];        {  Get Interrupt Identification        }
  95.   If (IIRreg and $01) = 0 then Begin    {  If interrupt pending                }
  96.     IIRreg := IIRreg and $06;           {  Leave bits 2 and 1 on               }
  97.     Case IIRreg of                      {  Determine cause of interrupt (we
  98.                                            actually only expect (and handle)
  99.                                            the Data Available interrupt        }
  100.  
  101.       $04: Begin                        {  Received Data Available Interrupt   }
  102.              If LSRstat = 0 then Begin  {  If Line Status is OK                }
  103.                                         {  If there is Room in Buffer          }
  104.                If (SUCC(writptr) <> readptr then Begin
  105.                                         {  Receive byte into our buffer        }
  106.                  ringbuf[writptr] := CHR(PORT[ComBase + RBR]);
  107.                                         {  Increment writptr                   }
  108.                  writptr := SUCC(writptr) mod 256;
  109.                End
  110.                                         {  If buffer full, pretend overrun     }
  111.                Else LSRstat := (LSRstat or $02);
  112.              End;
  113.            End;
  114.       $06: LSRstat := PORT[ComBase + LSR] and $1E;
  115.       $02: Begin End;
  116.       $00: MSRstat := PORT[ComBase + MSR];
  117.       Else Begin End;
  118.     End;  {  Case  }
  119.   End;
  120.   PORT[PICCMD] := $20;                  {  Send End Of Interrupt to 8259       }
  121.  
  122.   inline($1F);                          {  pop    ds                           }
  123.   inline($07/$5E/$5F/$5A/$59/$5B/$58);  {  pop rest of regs                    }
  124.   inline($89/$EC);                      {  mov    sp,bp                        }
  125.   inline($5D);                          {  pop    bp                           }
  126.   inline($CF);                          {  iret       ;Return from interrupt   }
  127. End;
  128.  
  129.  
  130. {                     Open COM1 or COM2, a la Basic                  }
  131.  
  132. Procedure OpenCom(ComPort: tComPort;
  133.                   Baud: tBaud;
  134.                   Parity: tParity;
  135.                   Databits: tDatabits;
  136.                   Stopbits: tStopbits);
  137. Const baudcode: array[b110..b9600] of integer =
  138.                            ($417, $300, $180, $C0, $60, $30, $18, $0C);
  139.       paritycode: array[pSpace..pNone] of byte =
  140.                                              ($38, $08, $28, $18, $00);
  141.       databitscode: array[d5..d8] of byte = ($00, $01, $02, $03);
  142.       stopbitscode: array[s1..s2] of byte = ($00, $04);
  143. Var   LCRreg: byte;
  144.  
  145. Begin
  146.                                         {  Init the Const "ourDS" for use by
  147.                                            the Async_Interrupt routine         }
  148.   inline($1E);                          {  push   ds                           }
  149.   inline($2E/$8F/$06/ourDS);            {  cs:pop ourDS                        }
  150.                                         {  Swap Com interrupt vector           }
  151.   With ComSaveVec Do Begin
  152.     CS := CSEG;
  153.     IP := OFS(Asynch_Interrupt);
  154.   End;
  155.   SwapIntVector(ivlist[ComPort], ComSaveVec);
  156.   ActiveComPort := ComPort;
  157.           inline($CD/$01);
  158.   ComBase := ComBaseAddr[ComPort];
  159.   LSRstat := 0;                         {  Reset LSR status          }
  160.   imvalue := imlist[ComPort];           {  Select Interrupt Mask val }
  161.   ComBase := ComBaseAddr[ComPort];      {  Select Input Port         }
  162.   readptr := 0;                         {  Init buffer pointers      }
  163.   writptr := 0;                         {  Init buffer pointers      }
  164.   PORT[PICMSK] := PORT[PICMSK] and imvalue;  {  Enable ASynch Int    }
  165.   PORT[IER+ComBase] := $01;             {  Enable some interrupts    }
  166.                               { Note: OUT2, despite documentation,
  167.                                  MUST be ON, to enable interrupts     }
  168.   PORT[MCR+ComBase] := $0B;             {  Set RTS, DTR, OUT2        }
  169.   LCRreg := $80;              {  Set Divisor Latch Access Bit in LCR }
  170.   LCRreg := LCRreg or paritycode[Parity];    {  Setup Parity         }
  171.   LCRreg := LCRreg or databitscode[Databits];{  Setup # data bits    }
  172.   LCRreg := LCRreg or stopbitscode[Stopbits];{  Setup # stop bits    }
  173.   PORT[LCR+ComBase] := LCRreg;     {  Set Parity, Data and Stop Bits
  174.                                        and set DLAB                   }
  175.   PORT[DLM+ComBase] := Hi(baudcode[Baud]);   {  Set Baud rate        }
  176.   PORT[DLL+ComBase] := Lo(baudcode[Baud]);   {  Set Baud rate        }
  177.   PORT[LCR+ComBase] := LCRreg and $7F;  {  Reset DLAB                }
  178.           inline($CD/$01);
  179. End;
  180.  
  181.  
  182. {                 Close any initialized COM                          }
  183.  
  184. Procedure CloseCom;
  185. Begin
  186.                               {  Disable Async interrupt             }
  187.   PORT[PICMSK] := PORT[PICMSK] or ($FF - imvalue);
  188.   PORT[IER+ComBase] := $00;   {  Disable Data Avail interrupt        }
  189.                               {  Restore Com interrupt vector        }
  190.   SwapIntVector(ivlist[ActiveComPort], ComSaveVec);
  191. End;
  192.  
  193. {
  194. Read a stream of data from the initialized COM port. If Line
  195. Status is not currently zero, then return immediately with
  196. the Line Status byte. If there is no data currently in the
  197. buffer then return stream:=null with function:=0. If there
  198. is data in the buffer, then return all the data up to, but
  199. not including, a CR($0D). If a CR is not found in the buffer
  200. then loop here until one arrives.
  201. }
  202.  
  203. Function  ReadCom(var stream: lstring): byte;{  Returned LSR, or zero}
  204.  
  205.   Function  ReadChar: char;   {  Return char, or SPIN !!!!           }
  206.   Begin
  207.     If readptr = writptr then
  208.                            Repeat Begin End Until (readptr <> writptr);
  209.     ReadChar := ringbuf[readptr];
  210.     readptr := SUCC(readptr) mod 256;
  211.   End;
  212.  
  213. Begin
  214.   stream[0] := CHAR($00);          {  Init returned string to null   }
  215.   ReadCom := LSRstat;              {  Return LSR, or zero            }
  216.   If LSRstat = 0 then Begin
  217.     If readptr <> writptr then Begin    {  If buffer not empty       }
  218.       Repeat Begin                      {  Get chars from ring buffer}
  219.                                    {  Increment returned string len  }
  220.         stream[0] := CHAR(ORD(SUCC(stream[0])));
  221.                                    {  Get a char from buffer, or SPIN}
  222.         stream[ORD(stream[0])] := ReadChar;
  223.       End
  224.       Until (stream[ORD(stream[0])] = CHR($0D));  {  Until see a CR  }
  225.       stream[0] := CHR(ORD(stream[0]) - 1);       {  strip the CR    }
  226.     End;
  227.   End;
  228. End;
  229.  
  230. {
  231. Write a stream of data to the initialized COM port, then
  232. append a CR and LF.
  233. }
  234.  
  235. Procedure WriteCom(stream: lstring);
  236. Var LSRreg: byte;
  237.     i: integer;
  238. Begin
  239.   inline($FA);                {  disable interrupts until we get all
  240.                                   the data sent.                      }
  241.   For i := 1 to LENGTH(stream) Do Begin
  242.                               {  Spin until Transmitter Holding
  243.                                   Register (THRE) is empty            }
  244.     Repeat LSRreg := (PORT[LSR+ComBase] and $20) Until LSRreg <> 0;
  245.     PORT[THR+ComBase] := ORD(stream[i]);     {  Output the caharacter}
  246.   End;
  247.   Repeat LSRreg := (PORT[LSR+ComBase] and $20) Until LSRreg <> 0;
  248.   PORT[THR+ComBase] := $0D;   {  Output a CR                         }
  249.   Repeat LSRreg := (PORT[LSR+ComBase] and $20) Until LSRreg <> 0;
  250.   PORT[THR+ComBase] := $0A;   {  Output a LF                         }
  251.   inline($FB);                {  Reenable interrupts                 }
  252. End;
  253.  
  254. begin end.